OS. エンベロープテーブルマクロ

このマクロの目的は、STAAD.Proで結果のエンベロープを含む結果テーブルを作成することです。

マクロには、次のルーチンが含まれています。

Main - これは、マクロが起動されるメインのルーチンです。STAAD.Proが実行中であり、ロードされたモデルにこの例に必要な利用できる結果があることを確認します。ただし、作成するテーブルでモデルを解析する必要がない場合は、その部分をルーチンから明確に削除できます。
STAADTable - 検証が完了すると、このルーチンが呼び出され、STAAD.Proでテーブルが生成されます。このテーブルでは荷重ケースの選択が必要なため、SelectLoadCasesという荷重ケースを選択するルーチン、次にCreateTableという空のテーブルを作成するルーチン、最後にFillTableというテーブルにデータを入力するルーチンの呼び出しがあります。
ResetEnvTable - テーブルがクリアされていることを確認する簡単なルーチンです。この例では、ノード変位テーブルの一般的なエンベロープのシートで使用されているラベルを鏡映するように各行の1列目にラベルが追加されます。
SelectLoadCases - これは、どの荷重ケースと組み合わせのノード変位を使用して最終的なテーブルを形成するかを選択するためのユーザーダイアログを表示するルーチンです。AddLoadCaseToSelectedとExcludeLoadCaseFromSelectedの他の2つのルーチンを使用して、STAAD.Proから利用できる荷重ケースのリストとテーブルの作成に使用される荷重ケースのリストの2つを保守します。
AddLoadCaseToSelected －「>」をクリックしたときに、このルーチンによって選択した荷重ケースが追加されます。
ExcludeLoadCaseFromSelected - 「除外」をクリックしたときに、選択された荷重ケースのリストにある荷重ケースがリストから削除されます。
CreateEnvList - 「選択された荷重ケース」ダイアログボックスのテキストから荷重ケース番号のリストを作成する簡単なルーチンです。
FillTable - 2次元配列（行と列）に入力された計算データをテーブルに取り込みます。
CreateTable - テーブルの枠組みを形成して見出しを設定するルーチンです。ヘッダーに適切な単位を含めることができるように、単位系もチェックされることに注意してください。また、端断面力や反力などの他のデータに使用できる追加のシートをレポートに含める方法を示すコメントアウトされた行があることにも注意してください。

マクロコード

このマクロを使用するには、コードをコピーして.vbsファイルに貼り付けます（たとえば、Table Envelope.vbs）。次に、STAAD.Proにマクロをインポートして使用します。

'#Reference {EDA9FA7F-EFC9-4264-9513-39CF6E72604D}#1.0#0# C:\Program Files\Bentley\Engineering\STAAD.Pro 2023\ \STAAD\StaadPro.dll#OpenSTAADUI#OpenSTAADUI
'Simple Macro using OpenSTAAD to create a table of envelopes.
'v1.0 (22 Dec 2015) CA
'v1.1 (23 Dec 2015) CA - Minor index issue fixes
'v1.2 (08 May 2020) JTC - Update with CE

Option Explicit

Public staadObj As Object
Public Geometry As OSGeometryUI
Public Loads As OSLoadUI
Public Output As OSOutputUI
Public Tables As OSTableUI

Sub Main()
Dim stdFile As String
Dim nResult As Boolean

Set staadObj = GetObject(,"StaadPro.OpenSTAAD")
Set Geometry = staadObj.Geometry
Set Loads = staadObj.Load
Set Output = staadObj.Output
Set Tables = staadObj.Table

'Make sure STAAD is loaded and running
staadObj.GetSTAADFile(stdFile,True)

If stdFile <> "" Then 'no file loaded
 'Check there are results
 nResult = Output.AreResultsAvailable
 If nResult = True Then 'Results are available
 STAADTable staadObj
 Else
 MsgBox "This macro requires the current model to have results.", vbOkOnly
 End If
Else
 MsgBox "This macro can only be run with a valid STAAD file loaded.", vbOkOnly
End If

Set staadObj = Nothing
End Sub


Sub STAADTable(staadObj As Object)
 Dim nReturn As Integer
 Dim i As Integer, j As Integer, k As Integer
 'Dim Geometry As OSGeometryUI
 'Set Geometry = staadObj.Geometry

 Dim nTableRows As Integer, nCols As Integer
 nTableRows=13
 nCols = 10

 Dim tblNodes As Long, rptno As Long

 Dim lPrimaryLoadCaseCount As Long
 Dim lPrimaryLoadCaseNumbersArray() As Long
 Dim lGetLoadCombinationCaseCount As Long
 Dim lLoadCombinationCaseNumbersArray() As Long

 Dim EnvList() As Long
 Dim LoadListCount As Integer

 SelectLoadCases staadObj, EnvList(), LoadListCount

 'MsgBox Str$(LoadListCount)

 Dim EnvRowVal(13) As Double
 Dim EnvRow(13,10) As String
 Dim LoadCase As Long
 Dim ColVal As Integer

 'Node Displacement Envelope

 Dim nNodes As Long
 Dim nNode() As Long
 nNodes = Geometry.GetNodeCount()
 ReDim nNode(nNodes)
 Geometry.GetNodeList(nNode)

 Dim dDisplacementArray(6) As Double

 Dim nResultant As Double

 ResetEnvTable EnvRow, nTableRows, nCols

 For i = 1 To LoadListCount
 LoadCase = EnvList(i)
 For j = 0 To nNodes-1
 nReturn = Output.GetNodeDisplacements( nNode(j), LoadCase, dDisplacementArray)
 nResultant = (dDisplacementArray(0)^2+dDisplacementArray(1)^2+dDisplacementArray(2)^2)^0.5
 For k = 1 To 6
 'max values
 If dDisplacementArray(k-1) > EnvRowVal(2*k-1) Then
 EnvRowVal(2*k-1) = dDisplacementArray(k-1)
 EnvRow(2*k-1, 2)= Str$(nNode(j))
 EnvRow(2*k-1, 3)= Str$(LoadCase)
 For ColVal = 1 To 3
 EnvRow(2*k-1, ColVal+3) = Format$(dDisplacementArray(ColVal-1),"#.000")
 Next ColVal
 EnvRow(2*k-1, ColVal+3) = Format$(nResultant,"#.000")
 For ColVal = 1 To 3
 EnvRow(2*k-1, ColVal+7) = Format$(dDisplacementArray(ColVal+2)*57.2958,"#.000")
 Next ColVal
 End If

 'min values
 If dDisplacementArray(k-1) < EnvRowVal(2*k) Then
 EnvRowVal(2*k) = dDisplacementArray(k-1)
 EnvRow(2*k, 2)= Str$(nNode(j))
 EnvRow(2*k, 3)= Str$(LoadCase)
 For ColVal = 1 To 3
 EnvRow(2*k, ColVal+3) = Format$(dDisplacementArray(ColVal-1),"#.000")
 Next ColVal
 EnvRow(2*k, ColVal+3) = Format$(nResultant,"#.000")
 For ColVal = 1 To 3
 EnvRow(2*k, ColVal+7) = Format$(dDisplacementArray(ColVal+2)*57.2958,"#.000")
 Next ColVal
 End If

 'resultant
 If nResultant > EnvRowVal(13) Then
 EnvRowVal(13) = nResultant
 EnvRow(13, 2)= Str$(nNode(j))
 EnvRow(13, 3)= Str$(LoadCase)
 For ColVal = 1 To 3
 EnvRow(13, ColVal+3) = Format$(dDisplacementArray(ColVal-1),"#.000")
 Next ColVal
 EnvRow(13, ColVal+3) = Format$(nResultant,"#.000")
 For ColVal = 1 To 3
 EnvRow(13, ColVal+7) = Format$(dDisplacementArray(ColVal+2)*57.2958,"#.000")
 Next ColVal
 End If
 Next k
 Next j
 Next i


'Create the Table
 'CreateTable staad,nTableRows,rptno, tblNodes, tblBeams,tblReactions, etc
 CreateTable staadObj, rptno, tblNodes, nTableRows

 'Now fill the data
 FillTable staadObj,rptno, tblNodes, EnvRow, nTableRows, nCols

End Sub


Sub ResetEnvTable(EnvRow() As String, nTableRows As Integer, nCols As Integer)
 Dim i As Integer, j As Integer

 For i = 1 To nCols
 For j = 1 To nTableRows
 EnvRow(j,i)="*"
 Next j
 Next i

 'Row lables
 EnvRow(1,1) = "Max X"
 EnvRow(2,1) = "Min X"
 EnvRow(3,1) = "Max Y"
 EnvRow(4,1) = "Min Y"
 EnvRow(5,1) = "Max Z"
 EnvRow(6,1) = "Min Z"
 EnvRow(7,1) = "Max rX"
 EnvRow(8,1) = "Min rX"
 EnvRow(9,1) = "Max rY"
 EnvRow(10,1) = "Min rY"
 EnvRow(11,1) = "Max rZ"
 EnvRow (12,1) = "Min rZ"
 EnvRow (13,1) = "Max Res."

End Sub


Sub SelectLoadCases(staadObj As Object, EnvList() As Long, lSelectedCasesNum As Integer)
 Dim i As Integer
 Dim j As Integer
 Dim nResult As Integer
 Dim iButton As Integer

 Dim LCases As Integer
 Dim LCCases As Integer
 Dim lstLoadNums() As Long
 Dim lstAvailableCases() As String

 LCases = Loads.GetPrimaryLoadCaseCount()
 ReDim lstLoadNums(LCases)
 ReDim lstAvailableCases(LCases)
 Loads.GetPrimaryLoadCaseNumbers (lstLoadNums)

 For i =0 To LCases-1
 lstAvailableCases(i)= CStr(lstLoadNums(i)) &" : " & Loads.GetLoadCaseTitle(lstLoadNums(i))
 Next i

 Dim lstLoadComNum() As Long
 LCCases = Loads.GetLoadCombinationCaseCount()
 ReDim lstLoadComNum(LCCases)
 ReDim Preserve lstLoadNums(LCases+LCCases)
 ReDim Preserve lstAvailableCases(LCases+LCCases)
 Loads.GetLoadCombinationCaseNumbers(lstLoadComNum)

 For i =0 To LCCases-1
 lstLoadNums(LCases+i)=lstLoadComNum(i)
 lstAvailableCases(LCases+i)= CStr(lstLoadNums(LCases+i)) &" : " & Loads.GetLoadCaseTitle(lstLoadNums(LCases+i))
 Next i

 Dim lstSelectedCases() As String
 lSelectedCasesNum = 0
 ReDim Preserve lstSelectedCases(lSelectedCasesNum)
 lstSelectedCases(0) = "(None)"

'Select load case dialog
 Begin Dialog UserDialog 720,287,"Select Load Cases and Combinations" ' %GRID:10,7,1,1
 Text 20,7,170,14,"Available Cases:-",.Text1
 ListBox 20,28,310,175,lstAvailableCases(),.AvailableListBox
 PushButton 350,98,40,28,">",.PushButton1
 PushButton 70,210,200,28,"Add All Cases",.AddAll
 Text 420,7,170,14,"Selected Cases:-",.Text2
 ListBox 410,28,290,175,lstSelectedCases(),.SelectedListBox
 PushButton 460,210,200,28,"Exclude Selected Case",.PushButton2
 OKButton 270,259,90,21
 CancelButton 380,259,90,21

 End Dialog
Dim dlg As UserDialog

'dlg.SelectedListBox = 1

 Do
 iButton = Dialog (dlg)

 Select Case iButton
 Case -1
 ' OK pressed
 If lSelectedCasesNum>0 Then
 ReDim EnvList(lSelectedCasesNum)
 CreateEnvList EnvList, lstSelectedCases, lSelectedCasesNum
 Else
 MsgBox "No load cases were selected."
 End
 End If

 Case 0
 'Cancel button Pressed
 End

 Case 1
 'Add button pressed
 Dim NewLoadCase As String
 NewLoadCase = lstAvailableCases(dlg.AvailableListBox)
 AddLoadCaseToSelected NewLoadCase, lstSelectedCases, lSelectedCasesNum

 Case 2
 'Add All cases
 lSelectedCasesNum = LCases+LCCases
 ReDim lstSelectedCases(lSelectedCasesNum)

 For i = 0 To lSelectedCasesNum-1
 lstSelectedCases(i) = lstAvailableCases(i)
 Next i

 Case 3
 'Exclude button pressed
 Dim RemoveLoadCase As String
 'Check if an item selected
 If dlg.SelectedListBox >-1 Then
 RemoveLoadCase = lstSelectedCases(dlg.SelectedListBox)
 ExcludeLoadCaseFromSelected RemoveLoadCase, lstSelectedCases, lSelectedCasesNum
 ReDim Preserve lstSelectedCases(lSelectedCasesNum)
 End If

 Case Else
 MsgBox "Error - We should not be here!.", vbOkOnly
 End

 End Select

 Loop Until iButton = -1


End Sub

Sub AddLoadCaseToSelected (NewLoadCase As String, lstSelectedCases() As String, lSelectedCasesNum As Integer)

 Dim i As Integer
 Dim CaseName As String

 'Check if first
 If lstSelectedCases(0)="(None)" Then
 lstSelectedCases(0) = NewLoadCase
 lSelectedCasesNum =1
 Else

 'Check if selected case is already in list
 For i = 1 To lSelectedCasesNum
 If NewLoadCase = lstSelectedCases(i-1) Then
 GoTo EndSub
 End If
 Next i

 'if not current included, add the selected available load case to the selected list
 lSelectedCasesNum = lSelectedCasesNum+1
 ReDim Preserve lstSelectedCases(lSelectedCasesNum)
 lstSelectedCases(lSelectedCasesNum-1)= NewLoadCase

 End If

EndSub:
End Sub



Sub ExcludeLoadCaseFromSelected (RemoveLoadCase As String, lstSelectedCases() As String, lSelectedCasesNum As Integer)

 Dim i As Integer, nReduce As Integer
 Dim CaseName As String

 If lSelectedCasesNum =1 Then
 lstSelectedCases(0) = "(None)"
 GoTo EndSub
 End If

 For i = 0 To lSelectedCasesNum-1
 If RemoveLoadCase = lstSelectedCases (i) Then
 nReduce = 1
 If i = lSelectedCasesNum Then
 lstSelectedCases(i) = "(last)"
 Else
 lstSelectedCases(i) = lstSelectedCases(i+1)
 RemoveLoadCase = lstSelectedCases(i)
 End If
 End If
 Next i

'remove the selected load case from the selected list
 'lSelectedCasesNum = lSelectedCasesNum-1
 lSelectedCasesNum = lSelectedCasesNum - nReduce
 ReDim Preserve lSelectedCases(lSelectedCasesNum)

EndSub:
End Sub


Sub CreateEnvList (EnvList() As Long, lstSelectedCases() As String, lSelectedCasesNum As Integer)

 Dim i As Integer

 For i = 1 To lSelectedCasesNum
 EnvList(i) = Val(lstSelectedCases(i-1))
 Next i

End Sub


Sub FillTable (staadObj As Object, rptno As Long, tblNodeDisplacement As Long, EnvRow() As String, nRows As Integer, nCols As Integer)

 Dim i As Integer, j As Integer

 For i = 1 To nRows
 For j =1 To nCols
 Tables.SetCellValue(rptno,tblNodeDisplacement,i,j, EnvRow(i,j))
 Next j
 Next i

End Sub


Sub CreateTable(staadObj As Object, rptno As Long, tblNodeDisplacement As Long, NoRows As Integer)
 Dim unit As Integer
 Dim ForceLabel As String, DistanceLabel As String
 unit = staadObj.GetBaseUnit
 Select Case unit
 Case 1 ' English
 DistanceLabel ="in"
 ForceLabel="kiP"
 Case 2 'Metric
 'DistanceLabel ="m"
 'Displacements for metric models will generally be wanted in mm
 DistanceLabel ="mm"
 ForceLabel="kN"
 Case Else 'This should not occur!
 DistanceLabel ="**"
 ForceLabel="???"
 End Select

'Table name
 rptno = Tables.CreateReport("User Envelopes")

'Table sheet name, number of rows and columns
 tblNodeDisplacement = Tables.AddTable(rptno, "Node Displacements", NoRows, 10)
 'tblEndForce = staad.Table.AddTable(rptno, "End Forces", NoRows, 10)
 'tblReaction = staad.Table.AddTable(rptno, "Reactionss", NoRows, 10)

'Column headings
 Tables.SetColumnHeader rptno, tblNodeDisplacement, 1, "(Type)"
 Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 1, "")

 Tables.SetColumnHeader rptno, tblNodeDisplacement, 2, "Node"
 Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 2, "")

 Tables.SetColumnHeader rptno, tblNodeDisplacement, 3, "L/C"
 Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 3, "")

 Tables.SetColumnHeader rptno, tblNodeDisplacement, 4, "X"
 Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 4, DistanceLabel)

 Tables.SetColumnHeader rptno, tblNodeDisplacement, 5, "Y"
 Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 5, DistanceLabel)

 Tables.SetColumnHeader rptno, tblNodeDisplacement, 6, "Z"
 Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 6, DistanceLabel)

 Tables.SetColumnHeader rptno, tblNodeDisplacement, 7, "Resultant"
 Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 7, DistanceLabel)

 Tables.SetColumnHeader rptno, tblNodeDisplacement, 8, "rX"
 Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 8, "deg")

 Tables.SetColumnHeader rptno, tblNodeDisplacement, 9, "rY"
 Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 9, "deg")

 Tables.SetColumnHeader rptno, tblNodeDisplacement, 10, "rZ"
 Tables.SetColumnUnitString( rptno, tblNodeDisplacement, 10, "deg")

End Sub